home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Pier Shareware 1
/
Pier Shareware 1.iso
/
007a
/
courspas.exe
/
CHAP11.EXE
/
TYP3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1980-01-04
|
4KB
|
124 lines
program m_a_jour_fichier_type; {TYP3.PAS}
uses
crt; { unité de Turbo Pascal 6 }
const
nom = 'TESTSTR.DAT'; { fichier sur disquette }
type
str20 = string[20];
var
element: str20;
f : file of str20;
{------------------------------------------------}
{ attendre }
{------------------------------------------------}
procedure attendre;
var ch: char;
begin
gotoxy(1,25); write('Veuillez appuyer sur une touche...');
ch:= readkey;
gotoxy(1,25); clreol
end;
{------------------------------------------------}
{ lireElements }
{------------------------------------------------}
procedure lireElements;
var i: integer; { compteur }
begin
clrscr;
seek(f,0); { pointeur au début du fichier }
writeln('Liste des éléments contenus par le fichier:');
writeln;
writeln('Nombre d''éléments: ',filesize(f));
writeln;
i:= 0; { valeur de début }
while not eof(f) do
begin
inc(i); { i:= i+1, pour compter }
read(f,element); { lecture des éléments }
writeln(i:3,': ',element); { affichage }
end; { while }
attendre;
end;
{------------------------------------------------}
{ m_a_jour_enregistr }
{------------------------------------------------}
procedure m_a_jour_enregistr;
var
nombr, { nombre d'enregistrements }
pos : integer; { position de la modif. }
begin
repeat
clrscr;
writeln('Mise à jour des enregistrements!');
writeln('Pour Q U I T T E R, frappez 0');
writeln;
nombr:= filesize(f);
writeln;
writeln('Valeurs possibles de POS: ');
writeln(' 1 <= POS <= ',nombr);
repeat
gotoxy(20,10);
write('Position de la modification? ');
readln(pos);
pos:=pos-1;
until (pos >= -1) and (pos <= nombr-1);
if pos <> -1
then begin
seek(f,pos); { pointeur sur l'élément }
read(f,element);{ lecture de l'élément }
gotoxy(20,12);
write('Contenu actuel: ',element);
gotoxy(20,14);
write('Nouveau contenu?: ');
readln(element);
seek(f,pos); { pointeur sur l'élément }
write(f,element); { écriture de l'élément}
lireElements;
end;
until pos = -1;
end;
{------------------------------------------------}
{ ajout_enregistr }
{------------------------------------------------}
procedure ajout_enregistr;
var nomFamill: str20; { nouvel enregistrement }
begin
writeln('Ajouter 1 élément au fichier ',nom,':');
writeln;
seek(f,filesize(f)); { derrière le dernier élément}
write('Veuillez introduire un nom (20 car. max.): ');
readln(nomFamill);
write(f,nomFamill); { écriture dans le fichier }
lireElements; { affichage du nouveau contenu }
end;
{------------------------------------------------}
begin { programme principal }
clrscr;
assign(f,nom); { liaison des fichiers }
{$I-} { inhibe la détect. d'erreurs }
reset(f); { ouvre le fichier précédent }
{$I+} { rétabl. la détect. d'erreurs }
if ioResult = 0
then begin
ajout_enregistr;
m_a_jour_enregistr;
close(f);
end
else begin
writeln('Erreur à l''ouverture');
writeln('du fichier! ');
writeln;
writeln('Prog. interrompu! ');
attendre;
end;
clrscr;
attendre;
end.